home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / explor2a / registry.cls < prev   
Text File  |  1999-09-27  |  3KB  |  103 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Registry"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. 'xx.savestring HKEY_LOCAL_MACHINE, "software\UnpreXisten\Online Code Browser\", "AppPath", App.Path
  11. 'MsgBox xx.GetString(HKEY_LOCAL_MACHINE, "software\UnpreXisten\Online Code Browser\", "AppPath")
  12. Private Const HKEY_CLASSES_ROOT = &H80000000
  13. Private Const HKEY_CURRENT_USER = &H80000001
  14. Private Const HKEY_LOCAL_MACHINE = &H80000002
  15. Private Const HKEY_USERS = &H80000003
  16. Private Const HKEY_PERFORMANCE_DATA = &H80000004
  17. Private Const ERROR_SUCCESS = 0&
  18.  
  19. Private Const RegLocation = "software\UnpreXisten\Online Code Browser\"
  20. Private Const RegKey = HKEY_LOCAL_MACHINE
  21. Private AppVer As String * 8
  22.  
  23. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
  24.  
  25.  
  26. Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  27.  
  28.  
  29. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
  30.  
  31.  
  32. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
  33.  
  34.  
  35. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  36.  
  37.  
  38. Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
  39.  
  40.  
  41. Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
  42. Private Const REG_SZ = 1
  43. Private Const REG_DWORD = 4
  44.         
  45.             
  46.  
  47.  
  48. Public Function GetString(Hkey As Long, strPath As String, strValue As String)
  49.  
  50.  
  51.     Dim keyhand As Long
  52.     Dim datatype As Long
  53.     Dim lResult As Long
  54.     Dim strBuf As String
  55.     Dim lDataBufSize As Long
  56.     Dim intZeroPos As Integer
  57.     r = RegOpenKey(Hkey, strPath, keyhand)
  58.     lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
  59.  
  60.  
  61.     If lValueType = REG_SZ Then
  62.         strBuf = String(lDataBufSize, " ")
  63.         lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
  64.  
  65.  
  66.         If lResult = ERROR_SUCCESS Then
  67.             intZeroPos = InStr(strBuf, Chr$(0))
  68.  
  69.  
  70.             If intZeroPos > 0 Then
  71.                 GetString = Left$(strBuf, intZeroPos - 1)
  72.             Else
  73.                 GetString = strBuf
  74.             End If
  75.  
  76.  
  77.         End If
  78.  
  79.  
  80.     End If
  81.  
  82.  
  83. End Function
  84.  
  85.  
  86.  
  87. Public Sub SaveString(Hkey As Long, strPath As String, strValue As String, strdata As String)
  88.  
  89.  
  90.     Dim keyhand As Long
  91.     Dim r As Long
  92.     r = RegCreateKey(Hkey, strPath, keyhand)
  93.     r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
  94.     r = RegCloseKey(keyhand)
  95. End Sub
  96.  
  97. Public Sub About()
  98.  
  99.     MsgBox "Registry Access Class" & Chr(13) & "Copyright ⌐1999 UnpreXisten" & Chr(13) & Chr(13) & "This software is FREEWARE and may only be distributed in its original form", vbInformation, "About"
  100.     
  101. End Sub
  102.  
  103.